perm filename MAKNUM.FAI[XX,LCS] blob
sn#256050 filedate 1976-12-30 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE MAKNUM
C00015 ENDMK
Cā;
TITLE MAKNUM
ENTRY MAKNUM
EXTERNAL ITMSUB,ALPHA,IFIX,NOZERO,.COMM.,STF,FLOAT,AMOD,CENTX,SLUR
MAKNUM: 0 ; SUBROUTINE MAKNUM(RNUM)
;100 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/STF/RSTFAC(-3/4),RSTJ2
;200 EQUIVALENCE (J3,JQ(1)),(R4,RJQ(2)),(R8,RJQ(6)),(R7,RJQ(5))
;300 1,(R6,RJQ(4)),(R5,RJQ(3)),(R7,RJQ(5)),(JQ(15),B),(JQ(16),C)
;400 1 ,(J8,JQ(6)),(J10,JQ(8)),(R3,RJQ(1)),(J5,JQ(3)),(RJY,JQ(19))
;500 1 ,(J7,JQ(5)),(J6,JQ(4)),(R9,RJQ(7))
;600 DATA RS/10.0/,RBX/1.0/
MOVE 11,@(16)
;700 RB8=R8
MOVE 02,.COMM.+=9
MOVEM 02,RB8#
MOVE 02,.COMM.+=24 ; J3X=J3
MOVEM 02,J3X# ; P7=0=BDR40; =1=BDI40; =2=PRIM.
JSA 16,NOZERO ; CALL NOZERO(R6)
JUMP .COMM.+7
MOVE 02,.COMM.+7 ; R5=R6
MOVEM 02,.COMM.+6 ; UPPER CASE - BDR40
MOVSI 02,206620 ; R6=48000000.0+(R7+50.)*10000.
FADR 02,.COMM.+=8
FMPR 02,[10000.0]
FADR 02,[48000000.0]
MOVEM 02,.COMM.+7
MOVE 02,[99999999.0] ; R7=99999999.0
MOVEM 02,.COMM.+=8
; 32500 C BLANKS
; 32700 IF(RNUM.NE.9999.)GO TO 2
CAME 11,[9999.0]
JRST MN2
; 32800 C NEXT FOR 'C'OMMON TIME
; 32900 RNUM=12.
MOVSI 11,204600
; 33000 C MAKES A 'C'
; 33100 R4=R4-2.2
MOVN 02,[2.2]
FADRM 02,.COMM.+5
; 33200 C .2 FOR BAD POS. OF LETTERS
; 33300 GO TO 4
JRST MN4
; 33500 2 ONE=0
MN2: SETZM ONE#
; 33600 RNUM=IFIX(RNUM)
JSA 16,IFIX
JUMP 11
MOVEM 11
JSA 16,FLOAT
JUMP 11
MOVEM 11
; 33700 C SO MISTAKES (I.E. 2.2) WON'T BREAK THE PROG.
; 33800 IF(RNUM.EQ.1.)ONE=3.
MOVSI 02,201400
CAME 02,11
JRST .+3
MOVSI 02,202600
MOVEM 02,ONE
; 33900 IF(RNUM.GT.9.)GO TO 3
MOVSI 02,204440
CAMGE 02,11
JRST MN3
; 34000 C JUMP FOR 2 OR 3 DIGIT NUMBER
; 34100 4 R6=R6+RNUM*100.+47.
MN4: MOVSI 02,206570
MOVSI 03,207620
FMPR 03,11
FADR 02,3
FADRM 02,.COMM.+7
; 34200 C PUTS BLANK ON END (.47)
; 34300 GO TO 1
JRST MN1
; 34500 3 RJY=10.
MN3: MOVSI 02,204500
MOVEM 02,RJY#
; 34600 IF(RNUM.GE.100.)RJY=100.
MOVSI 02,207620
CAMLE 02,11
JRST .+3
MOVSI 02,207620
MOVEM 02,RJY
; 34700 B=IFIX(RNUM/RJY)
MOVE 02,11
FDVR 02,RJY
MOVEM 02,B#
JSA 16,IFIX
JUMP B#
MOVEM B#
JSA 16,FLOAT
JUMP B#
MOVEM B
; 34800 C=AMOD(RNUM,RJY)
JSA 16,AMOD
JUMP 11
JUMP RJY
MOVEM C#
; 34900 IF(RNUM.LT.100)GO TO 7
MOVSI 02,207620
CAMLE 02,11
JRST MN7
; 35000 D=IFIX(C/10.)
MOVE 02,C
FDVR 02,[10.0]
MOVEM 02,D#
JSA 16,IFIX
JUMP D
MOVEM D
JSA 16,FLOAT
JUMP D
MOVEM D
; 35100 C=AMOD(C,10.)
JSA 16,AMOD
JUMP C
JUMP [10.0]
MOVEM C
; 35200 IF(C.EQ.1.)ONE=ONE+3.
MOVSI 3,201400
CAME 3,C
JRST .+3
MOVSI 02,202600
FADRM 02,ONE
; 35300 R7=C*1000000.+999999.0
MOVE 02,[1000000.0]
FMPR 02,C
FADR 02,[999999.0]
MOVEM 02,.COMM.+=8
; 35400 C=D
MOVE 02,D
MOVEM 02,C
; 35500 7 R6=R6+B*100.+C
MN7: MOVE 02,.COMM.+7
FADR 02,C
MOVSI 03,207620
FMPR 03,B
FADR 02,3
MOVEM 02,.COMM.+7
; 35600 IF(B.EQ.1.)ONE=ONE+3.
MOVSI 02,201400
CAME 02,B
JRST .+3
MOVSI 02,202600
FADRM 02,ONE
; 35700 IF(C.EQ.1.)ONE=ONE+3.
MOVSI 02,201400
CAME 02,C
JRST .+3
MOVSI 02,202600
FADRM 02,ONE
; 35800 B=R5
MOVE 02,.COMM.+6
MOVEM 02,B
; 35900 IF(RNUM.GE.100.)B=B*2
MOVSI 02,207620
CAMLE 02,11
JRST .+3
MOVSI 02,202400
FMPRM 02,B
; 36000 J3=J3-RS*RSTJ2*B
MOVE 02,[10.0]
FMPR 02,STF+=8
FMPR 02,B
JSA 16,FLOAT
JUMP .COMM.+=24
FSBR 2
MOVEM 3
JSA 16,IFIX
JUMP 3
MOVEM .COMM.+=24
; 36100 C FOR 2 DIGIT NUMBER
; 36600 C ADJUSTS FOR 11, ETC.
; 36900 1 J3=J3+ONE*R5*RSTJ2
MN1: MOVE 02,.COMM.+6
FMPR 02,ONE
FMPR 02,STF+=8
JSA 16,FLOAT
JUMP .COMM.+=24
FADR 2
MOVE 3,
JSA 16,IFIX
JUMP 3
MOVEM .COMM.+=24
; 37000 C CENTERS THE NUMBER '1'
; 37100 CALL ALPHA
JSA 16,ALPHA
; 37200 J3=J3X
MOVE 02,J3X#
MOVEM 02,.COMM.+=24
; 37300 IF(RB8.EQ.0)RETURN
SKIPN RB8
JRA 16,1(16)
; 37400 C NEXT FOR CIRCLES AND BOXES AROUND NUMBERS.
JSA 16,FLOAT ;37500 R3=J3-R5
JUMP .COMM.+=24
FSBR .COMM.+6
MOVEM .COMM.+4
SKIPE .COMM.+=31 ;37600 IF(J10.EQ.0)J10=1
JRST .+3
MOVEI 02,1
MOVEM 02,.COMM.+=31 ;USE J10 FOR EVEN THICKER BOX AND CIRC.
; 37800 IF(RNUM.GT.9)R3=R3+R5*RBX
MOVSI 02,204440
CAML 02,11
JRST .+4
MOVSI 02,201400
FMPR 02,.COMM.+6
FADRM 02,.COMM.+4
; 37900 C TO SET CENTER IF(RB8.EQ.2)GO TO 5
MOVSI 02,202400
CAMN 02,RB8
JRST MN5
MOVE 02,[0.05] ;38100 R4=R4+R5+.1+.05/R5
FDVR 02,.COMM.+6
FADR 2,[0.1]
FADR 02,.COMM.+6
FADRM 02,.COMM.+5
; 38200 C END OF ABOVE IS FOR SMALL CIRCLES.
MOVSI 02,203440 ;38300 B=4.5
MOVEM 02,B
; 38400 IF(RNUM.GE.100.)B=5.5
MOVSI 02,207620
CAMLE 02,11
JRST .+3
MOVSI 02,203540
MOVEM 02,B
; 38500 R5=R5*B
MOVE 02,B
FMPRM 02,.COMM.+6
; 38600 JA=12
MOVEI 02,11
MOVEM 02,.COMM.+1
; 38700 J6=0
SETZM .COMM.+=27
; 38800 J7=0
SETZM .COMM.+=28
; 38900 J8=J10
MOVE 02,.COMM.+=31
MOVEM 02,.COMM.+=29 ;39000 CALL CENTX
JSA 16,CENTX
JSA 16,SLUR ;39100 CALL SLUR
JRA 16,1(16) ;39200 RETURN
; 39400 5 JA=4
MN5: MOVEI 02,4
MOVEM 02,.COMM.+1
; 39500 B=6
MOVSI 02,203600
MOVEM 02,B
; 39600 R9=0
SETZM .COMM.+=10
; 39700 IF(RNUM.LT.100.)GO TO 8
MOVSI 02,207620
CAMLE 02,11
JRST MN8
; 39800 B=9.
MOVSI 02,204440
MOVEM 02,B
; 39900 R9=R5*6.
MOVSI 02,203600
FMPR 02,.COMM.+6
MOVEM 02,.COMM.+=10
; 40000 C MAKES RECTANGLE IF ā100
; 40100 8 R4=R4+R5*.7+.1
MN8: MOVE 03,[0.7]
FMPR 03,.COMM.+6
FADR 3,[0.1]
FADRM 3,.COMM.+5
; 40200 R8=R5*B
MOVE 02,.COMM.+6
FMPR 02,B
MOVEM 02,.COMM.+=9
; 40300 J5=50
MOVEI 02,62
MOVEM 02,.COMM.+=26
; 40400 CALL ITMSUB
JSA 16,ITMSUB
; 40500 C RETURNS ORIG. HORIZ. POS.
JRA 16,1(16) ;40600 END
END